PC Media 2/PC MEDIA CD02.iso/proein/trick/graph320.pas

Pascal/Delphi Source File | 1994-09-15 | 25.9 KB | 999 lines

Unit Graph320;

Interface

Uses Crt,Dos,Graph,VarAnima;

Var Peque,Peque2:Integer;

Procedure GetImgVirtual(GetCoordX1,GetCoordY1,GetCoordX2,GetCoordY2:Word;PantFondo,GTImagen:Pointer);
Procedure PutImgVirtual(PutCoordX,PutCoordY:Word;PantFondo,PtImagen:Pointer);
Procedure Linea(PrinX,PrinY,FinalX,FinalY:Word;Color:Byte);
Procedure Clear;
Procedure PintaPantalla(Pantalla:Pointer);
Procedure PutImg(CoordX,CoordY:Word; Imagen:Pointer);
Procedure PutSilueta(CoordX,CoordY:Word; Imagen:Pointer);
Procedure GetImg(CoordX1,CoordY1,CoordX2,CoordY2:Word;Imagen:Pointer);
Procedure CargaPaleta(Imagen:String8);
Procedure Efecto(NumeroEfecto:Byte;PasarANegro:Boolean;Pantalla2:Pointer);
Procedure Enciende_Luz;
Procedure Fundido_a_Negro_Total;
Procedure Fundido_a_Negro_Parcial(NumCol:Byte);
Procedure Fundido_de_Negro_Total(NumeroPaleta:Word;NombrePaleta:String8);
Procedure Fundido_de_Negro_Parcial(NumCol:Byte);
Procedure ActualizaPaleta(IndicePaleta:Byte);
Procedure CambiaPaleta(DePaleta,APaleta:Paleta);
Procedure CambiaBloqueRGB(PrimerColor:Byte;NumColores:Word;Var RGB);
Procedure Procesando_Activo;

Implementation

Var
 ExitGraph:Pointer;
 Autodetect:Pointer;
 RegGraph:Registers;
 DatosFundido:Array [0..63, 1..64] Of ShortInt;
 IPal,JPal:Byte;

Procedure GetImgVirtual(GetCoordX1,GetCoordY1,GetCoordX2,GetCoordY2:Word;PantFondo,GTImagen:Pointer);
Var
 PosAbs       : Word;
 TamanioFondo : Array [1..2]  of Word;
Begin
 TamanioFondo[1]:=Abs(GetCoordX2-GetCoordX1);
 TamanioFondo[2]:=Abs(GetCoordY2-GetCoordY1);
 Move(TamanioFondo,GTImagen^,4);
 PosAbs:=Ofs(PantFondo^)+4+GetCoordX1+GetCoordY1*320;
  asm
      { Captura la imagen desde la dirección de pantFondo en Imagen }
     mov  BX,word ptr [PantFondo+2]
     mov  ES,BX
     mov  BX,Word ptr [GTImagen+2]
     mov  SI,Word ptr [GTImagen]
     mov  AX,word ptr [PosAbs] { Offset de la imagen }
     mov  DI,AX
     push DS
     mov  DS,BX
     mov  CX,word ptr DS:[SI+2] { Altura  de la imagen }
     inc  CX
     mov  BX,word ptr DS:[SI] { Ancho  de la imagen }
     add  SI,4
     inc  BX
@L2:
     push CX
     mov  CX,BX { Ancho  de la imagen }
@L1:
     push CX
     mov  AL,ES:[DI]
     mov  DS:[SI],AL
     inc  SI
     inc  DI
     pop  CX
     loop @L1
     pop  CX
     add  DI,320
     sub  DI,BX
     loop @L2
     pop  DS
   end;
End;

Procedure PutImgVirtual(PutCoordX,PutCoordY:Word;PantFondo,PtImagen:Pointer);
Var
 PutPosAbs :Word;
Begin
 PutPosAbs:=PutCoordX+PutCoordY*320+Ofs(PantFondo^)+4;
  asm
      { Pinta la imagen desde la dirección del dibujo en DirDib
                       en la posición absoluta PosAbs }
     mov  BX,word ptr [PantFondo+2]
     mov  ES,BX
     mov  BX,Word ptr [PTImagen+2]
     mov  SI,Word ptr [PTImagen]
     mov  AX,word ptr [PutPosAbs] { Offset de la imagen }
     mov  DI,AX
     push DS
     mov  DS,BX
     mov  CX,word ptr DS:[SI+2] { Altura  de la imagen }
     inc  CX
     add  SI,4
     mov  BX,word ptr DS:[SI-4] { Ancho  de la imagen }
     inc  BX
     mov  AX,320
     sub  AX,BX   { número de puntos para el comienzo de la siguiente línea}
@L2:
     push CX
     mov  CX,BX   { Ancho  de la imagen }
     rep  movsb   { Pinta una línea }
     pop  CX
     add  DI,AX
     loop @L2
     pop  DS
   end;
End;

Procedure GetImg(CoordX1,CoordY1,CoordX2,CoordY2:Word;Imagen:Pointer);
Var
 PosAbs:Word;
 TamanioFondo:Array [1..2] of Word;
Begin
 TamanioFondo[1]:=Abs(CoordX2-CoordX1);
 TamanioFondo[2]:=Abs(CoordY2-CoordY1);
 Move(TamanioFondo,Imagen^,4);
 PosAbs:=CoordX1+CoordY1*320;
  asm
      { Captura la imagen desde la dirección del dibujo en DirDib
                         en la posición absoluta PosAbs }
     mov  BX,Word ptr Imagen+2
     mov  SI,Word ptr Imagen
     mov  AX,word ptr PosAbs { Offset de la imagen }
     mov  DI,AX
     push DS
     mov  DS,BX
     mov  CX,word ptr DS:[SI+2] { Altura  de la imagen }
     inc  CX
     mov  BX,0A000h
     mov  ES,BX
     mov  BX,word ptr DS:[SI] { Ancho  de la imagen }
     add  SI,4
     inc  BX
@L2:
     push CX
     push BX
     mov  CX,BX { Ancho  de la imagen }
@L1:
     mov  BL,ES:[DI]
     mov  DS:[SI],BL
     inc  SI
     inc  DI
     loop @L1
     pop  BX
     pop  CX
     add  DI,320
     sub  DI,BX
     loop @L2
     pop  DS
   end;
End;

Procedure PutSilueta(CoordX,CoordY:Word; Imagen:Pointer);
Var
 PosAbs :Word;
Begin
 PosAbs:=CoordX+CoordY*320;
  asm
      {   Pinta el dibujo sin fondo                                }
      {   desde la dirección del dibujo en DirDib                  }
      {   a la posición absoluta PosAbs                            }
     mov  BX,Word ptr Imagen+2
     mov  SI,Word ptr Imagen
     mov  AX,word ptr PosAbs { Offset de la imagen }
     mov  DI,AX
     push DS
     mov  DS,BX
     mov  CX,word ptr DS:[SI+2] { Altura  de la imagen }
     sub  CX,1   { ????????????????????????? }
     add  SI,4
     mov  BX,0A000h
     mov  ES,BX
     mov  BX,word ptr DS:[SI-4] { Ancho  de la imagen }
     inc  BX     { ????????????? }
@L2:
     push CX
     push BX
     mov  CX,BX { Ancho  de la imagen }
@L1:
     push CX
     cmp  DI,AX
     jnb  @L4
       {Acabar el procedimiento }
@L4:
     mov  BL,DS:[SI]         { Si el color no es cero pone el punto }
     cmp  BL,0
     je   @L3
     mov  ES:[DI],BL
@L3:
     Inc  SI
     inc  DI
     pop  CX
     loop @L1
     pop  BX
     pop  CX
     add  DI,320
     sub  DI,BX
     loop @L2
     pop  DS
   end;
End;

Procedure PintaPantalla(Pantalla:Pointer);
Begin
  asm
     push DS
     mov  SI,Word ptr Pantalla
     add  SI,4
     mov  DX,Word ptr Pantalla+2
     mov  DS,DX
     xor  DI,DI     { Comienzo del buffer de video (desplazamiento) }
     mov  DX,0A000h { Segmento de video         }
     mov  ES,DX
     mov  CX,22400  { Pantalla  completa a mover}
     rep  movsw
     pop  DS
   end;
End;

Procedure PutImg(CoordX,CoordY:Word; Imagen:Pointer);
Var
 PosAbs :Word;
Begin
 PosAbs:=CoordX+CoordY*320;
  asm
      { Pinta la imagen desde la dirección del dibujo en DirDib
                       en la posición absoluta PosAbs }
     mov  BX,Word ptr Imagen+2
     mov  SI,Word ptr Imagen
     mov  AX,word ptr PosAbs { Offset de la imagen }
     mov  DI,AX
     push DS
     mov  DS,BX
     mov  CX,word ptr DS:[SI+2] { Altura  de la imagen }
     inc  CX
     add  SI,4
     mov  BX,0A000h
     mov  ES,BX
     mov  BX,word ptr DS:[SI-4] { Ancho  de la imagen }
     inc  BX
     mov  AX,320
     sub  AX,BX   { número de puntos para el comienzo de la siguiente línea}
     push DX
     push AX
     push CX
     mov  DX,3DAh
@L6:
     in   AL,DX
     test AL,8
     loopnz @L6
     pop CX
     pop AX
     pop DX

@L2:
     push CX
     mov  CX,BX   { Ancho  de la imagen }
     rep  movsb   { Pinta una línea }
     pop  CX
     add  DI,AX
     loop @L2
     pop  DS
   end;
End;

Procedure Linea(PrinX,PrinY,FinalX,FinalY:Word;Color:Byte);
Var
 IncrYDiag,
 IncrXDiag,
 DistCorta,
 IncrXRecto,
 IncrYRecto,
 ContRecto,
 ContDiag    : Word;
Begin
 asm
  mov  DX,1
  mov  CX,1
  mov  DI,FinalY
  sub  DI,PrinY
  jge  @GuardaY
  neg  CX
  neg  DI
@GuardaY:
  mov  IncrYDiag,CX
  mov  SI,FinalX
  sub  SI,PrinX
  jge  @GuardaX
  neg  DX
  neg  SI
@GuardaX:
  mov  IncrXDiag,DX
  cmp  SI,DI
  jge  @SegHoriz
  mov  DX,0
  xchg SI,DI
  jmp  @GuardaValor
@SegHoriz:
  mov  CX,0
@GuardaValor:
  mov  DistCorta,DI
  mov  IncrXRecto,DX
  mov  IncrYRecto,CX
  mov  AX,DistCorta
  shl  AX,1
  mov  ContRecto,AX
  sub  AX,SI
  mov  BX,AX
  sub  AX,SI
  mov  ContDiag,AX
  mov  DX,PrinX
  mov  CX,PrinY
  inc  SI
  inc  SI
  mov  AL,Color
  mov  DI,0A000h
  mov  ES,DI
@Bucle:
  dec  SI
  jz   @Acabada

   push CX
   Xor  DI,DI
   cmp  CX,0
   jz   @Continua
@NumCol:
   add  DI,320
   loop @NumCol
@Continua:
   Add  DI,DX
   mov  ES:[DI],al
   pop  CX

  cmp  bx,0
  jge  @Diagonal
  add  DX,IncrXRecto
  add  CX,IncrYRecto
  add  BX,ContRecto
  jmp  @Bucle
@Diagonal:
  add  DX,IncrXDiag
  add  CX,IncrYDiag
  add  BX,ContDiag
  jmp  @Bucle
@Acabada:
 End;
End;

Procedure Clear; Assembler;
asm
  mov AX,$700
  mov BH,0
  mov CX,0
  mov DH,25
  mov DL,40
  int $10
end;

Procedure CargaPaleta(Imagen:String8);
Var Fichero:File of Paleta;
Begin
 Assign(Fichero,Imagen+'.PAL');
 {$I-} Reset(Fichero); {$I+}
 If IOResult<>0 Then Halt(310);
 Read(Fichero,Pal);
 Close(Fichero);
 RegGraph.AX:=$1012;
 RegGraph.BX:=0;
 RegGraph.CX:=256;
 If ContadorPC>89 Then Halt(274);
 RegGraph.ES:=Seg(Pal);
 RegGraph.DX:=Ofs(Pal);
 Intr($10,RegGraph);
End;

Procedure MCGADriver; External;
{$L VGA256.OBJ}

Procedure PequeFont; External;
{$L Litt.OBJ}

Procedure EuroFont; External;
{$L Euro.obj}

Function DetectVGA:Integer; Far;
Var Driver,Modo:Integer;
Begin
 DetectGraph(Driver,Modo);
 DetectVGA:=Driver;
 If ((Driver<>VGA) and (Driver<>MCGA))
  Then Halt(256);
End;

Procedure Inicializa;
Var
 GD,GM:Integer;
 PalKK:PaletteType;
Begin
 AutoDetect:=@DetectVGA;
 GD:=InstallUserDriver('VGA256',AutoDetect);
 GM:=Detect;
 If RegisterBGIDriver(@MCGADriver)<0
  Then Halt(308);
 If RegisterBGIFont(@PequeFont)<0
  Then Halt(309);
 Peque:=InstallUserFont('Litt');
 If RegisterBGIFont(@EuroFont)<0
  Then Halt(309);
 Peque2:=InstallUserFont('Euro');
 InitGraph(GD,GM,'');
 PalKK.Size:=16;
 For GM:=0 to 15 do
  PalKK.Colors[GM]:=GM;
 SetAllPalette(PalKK);
 Setcolor(255);
End;

Procedure GraphSalida;Far;
Begin
 ExitProc:=ExitGraph;
 CloseGraph;
End;

Procedure Efecto(NumeroEfecto:Byte;PasarANegro:Boolean;Pantalla2:Pointer);
Var
 I1,I2,I3:Word;
 J1,J2,J3:Word;
 OldColor:Byte;
 FillInfoMIO:FillSettingsType;
 PalPaso:Paleta;
Begin
 OldColor:=GetColor;
 GetFillSettings(FillInfoMIO);
 ContadorPC2:=ContadorPC;
 If ContadorPC>145 Then Halt(274);
 If PasarANegro
  Then
   Case NumeroEfecto of
    1:Begin {Efecto de cortina de arriba a abajo}
       SetColor(0);
       For I1:=0 to 69 do
        Begin
         Line(0,(I1*2),319,(I1*2));
         Delay(5);
        End;
       For I1:=70 Downto 1 do
        Begin
         Line(0,(I1*2-1),319,(I1*2-1));
         Delay(5);
        End;
      End;
    2:Begin {Efecto de cortina de abajo a arriba}
       SetColor(0);
       For I1:=70 Downto 1 do
        Begin
         Line(0,(I1*2-1),319,(I1*2-1));
         Delay(5);
        End;
       For I1:=0 to 69 do
        Begin
         Line(0,(I1*2),319,(I1*2));
         Delay(5);
        End;
      End;
    3:Begin { Cuadritos }
       SetFillStyle(1,0);
       For I2:=1 to 9 do
        Begin
         I1:=10;
         Repeat
          J1:=10;
          Repeat
           Bar((I1-I2),(J1-I2),(I1+I2),(J1+I2));
           Inc(J1,20);
          Until J1=150;
          Inc(I1,20);
         Until I1=330;
        End;
       Bar(0,0,319,139);
      End;
    4:Begin {Cuadros en cascada}
       SetFillStyle(1,0);
       For I2:=1 to 22 do
        Begin
         For I1:=1 to 16 do
          For J1:=1 to 7 do
           Begin
            If ((I1+J1)=(I2+1))
             Then
              Begin
               Bar(((I1-1)*20),((J1-1)*20),((I1-1)*20+19),((J1-1)*20+19));
               Delay(8);
              End;
           End;
        End;
      End;
    5:Begin {Espiral}
       SetColor(0);
        For J1:=0 to 139 do
         Line(0,J1,319,(139-J1));
        For J1:=318 Downto 1 do
         Line(J1,0,(319-J1),139);
      End;
    6:Begin {Fundido hacia dentro}
       SetColor(0);
       For I1:=0 to 70 do
        Begin
         Rectangle(I1,I1,(319-I1),(139-I1));
         Delay(5);
        End;
      End;
    7:Begin {Fundido hacia fuera}
       SetColor(0);
       For I1:=70 Downto 0 do
        Rectangle(I1,I1,(319-I1),(139-I1));
      End;
    8:Begin {Linea tipo guillotina centrada en 0,139}
       SetColor(0);
       For I1:=0 to 319 do
        Line(0,139,I1,0);
       For I1:=1 to 139 do
        Line(0,139,319,I1);
      End;
    9:Begin {Linea tipo guillotina centrada en 319,0}
       SetColor(0);
       For I1:=319 Downto 0 do
        Line(319,139,I1,0);
       For I1:=1 to 139 do
        Line(319,139,0,I1);
      End;
   10:Begin {Cuadrados en zigzag}
       SetFillStyle(1,0);
       For J1:=1 to 7 do
        If ((J1 Mod 2)=0)
         Then
          For I1:=1 to 16 do
           Begin
            Bar(((I1-1)*20),((J1-1)*20),((I1-1)*20+19),((J1-1)*20+19));
            Delay(8);
           End
         Else
          For I1:=16 Downto 1 do
           Begin
            Bar(((I1-1)*20),((J1-1)*20),((I1-1)*20+19),((J1-1)*20+19));
            Delay(8);
           End;
      End;
   11:Begin {Cuadros en espiral}
       SetFillStyle(1,0);
       For I2:=0 to 3 do
        Begin
         J1:=1+I2;
         For I1:=(1+I2) to (16-I2) do {Derecha}
          Begin
           Bar(((I1-1)*20),((J1-1)*20),((I1-1)*20+19),((J1-1)*20+19));
           Delay(8);
          End;
         For J1:=(2+I2) to (7-I2) do {Abajo}
          Begin
           Bar(((I1-1)*20),((J1-1)*20),((I1-1)*20+19),((J1-1)*20+19));
           Delay(8);
          End;
         For I1:=(16-I2) Downto (1+I2) do {izquierda}
          Begin
           Bar(((I1-1)*20),((J1-1)*20),((I1-1)*20+19),((J1-1)*20+19));
           Delay(8);
          End;
         For J1:=(6-I2) Downto (2+I2) do {Arriba}
          Begin
           Bar(((I1-1)*20),((J1-1)*20),((I1-1)*20+19),((J1-1)*20+19));
           Delay(8);
          End;
        End;
      End;
   12:Begin { Aleatorio }
       SetFillStyle(1,0);
       SetColor(0);
       For I1:=1 to 15000 do
        Begin
         I2:=Random(318);
         J2:=Random(138);
         Bar(I2,J2,(I2+2),(J2+2));
         PutPixel(Random(320),Random(139),0);
        End;
       Bar(0,0,319,139);
      End;
   13:Begin {Cortina vertical a izq}
       SetColor(0);
       For I1:=319 Downto 0 do
        Line(I1,0,I1,139);
      End;
   14:Begin { Cortina vertical a dcha }
       SetColor(0);
       For I1:=0 to 319 do
        Line(I1,0,I1,139);
      End;
   15:Begin  {apagado de tele}
       SetColor(0);
       For J1:=0 to 70 do
         Begin
          Move(Ptr($A000,(J1*320))^,Ptr($A000,((J1+1)*320))^,320);
          Line(0,J1,319,J1);
          Move(Ptr($A000,((139-J1)*320))^,Ptr($A000,((138-J1)*320))^,320);
          Line(0,(139-J1),319,(139-J1));
          Delay(2);
         End;
       Delay(5);
       For J1:=0 to 160 do
        Begin
         Line(0,68,J1,68);
         Line(319,68,(319-J1),68);
        End;
      End;
   End
  Else
   Case NumeroEfecto of
    1:Begin {Efecto de cortina de arriba a abajo}
       For I1:=0 to 69 do
        Begin
         Move(Ptr(Seg(Pantalla2^),(Ofs(Pantalla2^)+(I1*640)+4))^,
              Ptr($A000,(I1*640))^,320);
         Delay(5);
        End;
       For I1:=70 Downto 1 do
        Begin
         Move(Ptr(Seg(Pantalla2^),(Ofs(Pantalla2^)+((I1*640)-320)+4))^,
              Ptr($A000,((I1*640)-320))^,320);
         Delay(5);
        End;
      End;
    2,5,8,9:Begin {Efecto de cortina de abajo a arriba}
       For I1:=70 Downto 1 do
        Begin
         Move(Ptr(Seg(Pantalla2^),(Ofs(Pantalla2^)+((I1*640)-320)+4))^,
              Ptr($A000,((I1*640)-320))^,320);
         Delay(5);
        End;
       For I1:=0 to 69 do
        Begin
         Move(Ptr(Seg(Pantalla2^),(Ofs(Pantalla2^)+(I1*640)+4))^,
              Ptr($A000,(I1*640))^,320);
         Delay(5);
        End;
      End;
    3,7:Begin { Cuadritos }
       For I2:=1 to 9 do
        Begin
         I1:=10;
         Repeat
          J1:=10;
          Repeat
           For I3:=(J1-I2) to (J1+I2) do
            Move(Ptr(Seg(Pantalla2^),(Ofs(Pantalla2^)+4+(I3*320)+(I1-I2)))^,
                 Ptr($A000,((I3*320)+(I1-I2)))^,(I2*2));
           Inc(J1,20);
          Until J1=150;
          Inc(I1,20);
         Until I1=330;
        End;
       PintaPantalla(Pantalla2);
      End;
    4:Begin {Cuadros en cascada}
       SetFillStyle(1,0);
       For I2:=1 to 22 do
        Begin
         For I1:=1 to 16 do
          For J1:=1 to 7 do
           Begin
            If ((I1+J1)=(I2+1))
             Then
              Begin
               For I3:=((J1-1)*20) to ((J1-1)*20+19) do
                Move(Ptr(Seg(Pantalla2^),(Ofs(Pantalla2^)+4+(I3*320)+
                     ((I1-1)*20)))^,Ptr($A000,((I3*320)+((I1-1)*20)))^,20);
               Delay(8);
              End;
           End;
        End;
      End;
    6:Begin {Fundido hacia fuera}
       For I1:=70 Downto 0 do
        For J1:=I1 to (139-I1) do
         Move(Ptr(Seg(Pantalla2^),(Ofs(Pantalla2^)+4+(J1*320)+I1))^,
                     Ptr($A000,((J1*320)+I1))^,(319-(I1*2)));
      End;
   10:Begin {Cuadrados en zigzag}
       For J1:=1 to 7 do
        If ((J1 Mod 2)=0)
         Then
          For I1:=1 to 16 do
           Begin
            For J3:=((J1-1)*20) to ((J1-1)*20+19) do
             Move(Ptr(Seg(Pantalla2^),(Ofs(Pantalla2^)+4+(J3*320)+
                  ((I1-1)*20)))^,Ptr($A000,((J3*320)+((I1-1)*20)))^,20);
            Delay(8);
           End
         Else
          For I1:=16 Downto 1 do
           Begin
            For J3:=((J1-1)*20) to ((J1-1)*20+19) do
             Move(Ptr(Seg(Pantalla2^),(Ofs(Pantalla2^)+4+(J3*320)+
                  ((I1-1)*20)))^,Ptr($A000,((J3*320)+((I1-1)*20)))^,20);
            Delay(8);
           End;
      End;
   11:Begin {Cuadros en espiral}
       SetFillStyle(1,0);
       For I2:=0 to 3 do
        Begin
         J1:=1+I2;
         For I1:=(1+I2) to (16-I2) do {Derecha}
          Begin
           For J3:=((J1-1)*20) to ((J1-1)*20+19) do
             Move(Ptr(Seg(Pantalla2^),(Ofs(Pantalla2^)+4+(J3*320)+
                  ((I1-1)*20)))^,Ptr($A000,((J3*320)+((I1-1)*20)))^,20);
           Delay(8);
          End;
         For J1:=(2+I2) to (7-I2) do {Abajo}
          Begin
           For J3:=((J1-1)*20) to ((J1-1)*20+19) do
             Move(Ptr(Seg(Pantalla2^),(Ofs(Pantalla2^)+4+(J3*320)+
                  ((I1-1)*20)))^,Ptr($A000,((J3*320)+((I1-1)*20)))^,20);
           Delay(8);
          End;
         For I1:=(16-I2) Downto (1+I2) do {izquierda}
          Begin
           For J3:=((J1-1)*20) to ((J1-1)*20+19) do
             Move(Ptr(Seg(Pantalla2^),(Ofs(Pantalla2^)+4+(J3*320)+
                  ((I1-1)*20)))^,Ptr($A000,((J3*320)+((I1-1)*20)))^,20);
           Delay(8);
          End;
         For J1:=(6-I2) Downto (2+I2) do {Arriba}
          Begin
           For J3:=((J1-1)*20) to ((J1-1)*20+19) do
             Move(Ptr(Seg(Pantalla2^),(Ofs(Pantalla2^)+4+(J3*320)+
                  ((I1-1)*20)))^,Ptr($A000,((J3*320)+((I1-1)*20)))^,20);
           Delay(8);
          End;
        End;
      End;
   12:Begin { Aleatorio }
       For I1:=1 to 15000 do
        Begin
         I2:=Random(318);
         J2:=Random(138);
         Move(Ptr(Seg(Pantalla2^),(Ofs(Pantalla2^)+4+(J2*320)+I2))^,
              Ptr($A000,((J2*320)+I2))^,2);
         Move(Ptr(Seg(Pantalla2^),(Ofs(Pantalla2^)+4+((J2+1)*320)+I2))^,
              Ptr($A000,(((J2+1)*320)+I2))^,2);
         I2:=Random(320);
         J2:=Random(140);
         Move(Ptr(Seg(Pantalla2^),(Ofs(Pantalla2^)+4+(J2*320)+I2))^,
              Ptr($A000,((J2*320)+I2))^,1);
        End;
       PintaPantalla(Pantalla2);
      End;
   13:Begin { cortina vertical a dcha}
       For I1:=0 to 319 do
        For J1:=0 to 139 do
         Move(Ptr(Seg(Pantalla2^),(Ofs(Pantalla2^)+4+(J1*320)+I1))^,
              Ptr($A000,((J1*320)+I1))^,1);
      End;
   14:Begin { cortina vertical a izq}
       For I1:=319 Downto 0 do
        For J1:=0 to 139 do
         Move(Ptr(Seg(Pantalla2^),(Ofs(Pantalla2^)+4+(J1*320)+I1))^,
              Ptr($A000,((J1*320)+I1))^,1);
      End;
   15:Begin {encendido de tele}
       SetColor(255);
       For J1:=160 Downto 0 do
        Line(J1,69,(319-J1),69);
       Delay(5);
       For J1:=70 Downto 0 do
        Begin
         Move(Ptr(Seg(Pantalla2^),(Ofs(Pantalla2^)+4+J1*320))^,
              Ptr($A000,(J1*320))^,320);
         Move(Ptr(Seg(Pantalla2^),(Ofs(Pantalla2^)+4+(139-J1)*320))^,
              Ptr($A000,((139-J1)*320))^,320);
         Delay(2);
        End;
      End;
   End;
 SetColor(OldColor);
 SetFillStyle(FillInfoMIO.Pattern,FillInfoMIO.Color);
End;

Procedure CambiaBloqueRGB(PrimerColor:Byte;NumColores:Word;Var RGB);
Begin
  Asm
    MOV    DX, 3DAh       { *************************** }
    @vert1:               { *                         * }
    IN     AL, DX         { *     SINCRONIZACION      * }
    TEST   AL, 8          { *          CON            * }
    JNE    @vert1         { *          EL             * }
    @vert2:               { *        RETRACE          * }
    IN     AL, DX         { *        VERTICAL         * }
    TEST   AL, 8          { *                         * }
    JE     @vert2         { *************************** }
    PUSH  DS              { Salva DS, POR OBLIGACION }
    LDS   SI, RGB         { DS:SI -> Dirección de la paleta }
    MOV   AX, NumColores  { Número de colores a modificar }
    MOV   CX, AX          { CX se utiliza de contador }
    SHL   CX, 1           { CX = CX * 2 }
    ADD   CX, AX          { CX = CX + AX = 3 * NumColores, Nº de bytes RGB }
    MOV   AL, PrimerColor
    MOV   DX, 3C8h
    OUT   DX, AL          { 3C8h - Indica el primer registro RGB a modificar }
    INC   DX              { 3C9h - Aqui se escriben los colores }
    @OtraVez:
    LODSB                 { Carga AL }
    OUT   DX, AL          { Vuelca en 3C9h el valor del color RGB }
    LOOP  @OtraVez        { Cambia otro plano de color }
    POP   DS              { Restaura el DS }
  End;
End;

Procedure CambiaPaleta(DePaleta,APaleta:Paleta);
Var
 PalPaso:Paleta;
 AuxPaso:ShortInt;
Begin
  PalPaso:=DePaleta;
  For JPal:=32 DownTo 1 Do
    Begin
      For IPal:=0 To 255 Do
       Begin
        AuxPaso:=APaleta[IPal,1]-PalPaso[IPal,1];
        If AuxPaso>0
         Then PalPaso[IPal,1]:=PalPaso[IPal,1]+DatosFundido[AuxPaso,JPal]
         Else PalPaso[IPal,1]:=PalPaso[IPal,1]-DatosFundido[-AuxPaso,JPal];
        AuxPaso:= APaleta[IPal,2]-PalPaso[IPal,2];
        If AuxPaso>0
         Then PalPaso[IPal,2]:=PalPaso[IPal,2]+DatosFundido[AuxPaso,JPal]
         Else PalPaso[IPal,2]:=PalPaso[IPal,2]-DatosFundido[-AuxPaso,JPal];
        AuxPaso:=APaleta[IPal,3]-PalPaso[IPal,3];
        If AuxPaso>0
         Then PalPaso[IPal,3]:=PalPaso[IPal,3]+DatosFundido[AuxPaso,JPal]
         Else PalPaso[IPal,3]:=PalPaso[IPal,3]-DatosFundido[-AuxPaso,JPal];
        End;
      CambiaBloqueRGB(0,256,PalPaso);
    End;
End;

Procedure Enciende_Luz;
Var
 FichPaleta:File;
 PalPaso:Paleta;
Begin
 Assign(FichPaleta,'PALETAS.DAT');
 {$I-} Reset(FichPaleta,1); {$I+}
 If IOResult<>0 Then Halt(311);
 Seek(FichPaleta,1536);
 BlockRead(FichPaleta,PalPaso,768);
 Close(FichPaleta);
 For IPal:=201 to 255 do
  Begin
   PalPaso[IPal,1]:=Pal[IPal,1];
   PalPaso[IPal,2]:=Pal[IPal,2];
   PalPaso[IPal,3]:=Pal[IPal,3];
  End;
 CambiaPaleta(Pal,PalPaso);
 Pal:=PalPaso;
End;

Procedure Fundido_a_Negro_Total;
Var
 PalPaso:Paleta;
Begin
 For IPal:=0 To 255 Do
  Begin
   PalPaso[IPal,1]:=0;
   PalPaso[IPal,2]:=0;
   PalPaso[IPal,3]:=0;
  End;
 CambiaPaleta(Pal,PalPaso);
 Pal:=PalPaso;
End;

Procedure Fundido_a_Negro_Parcial(NumCol:Byte);
Var PalPaso:Paleta;
Begin
 For IPal:=0 To NumCol Do
  Begin
   PalPaso[IPal,1]:=0;
   PalPaso[IPal,2]:=0;
   PalPaso[IPal,3]:=0;
  End;
 For IPal:=(NumCol+1) To 255 Do
  Begin
   PalPaso[IPal,1]:=Pal[IPal,1];
   PalPaso[IPal,2]:=Pal[IPal,2];
   PalPaso[IPal,3]:=Pal[IPal,3];
  End;
 CambiaPaleta(Pal,PalPaso);
 Pal:=PalPaso;
End;

Procedure Fundido_de_Negro_Total(NumeroPaleta:Word;NombrePaleta:String8);
Var
 FichPaleta:File;
 PalPaso,PalNegro:Paleta;
Begin
 If NumeroPaleta>0
  Then
   Begin
    Assign(FichPaleta,'PALETAS.DAT');
    {$I-} Reset(FichPaleta,1); {$I+}
    If IOResult<>0 Then Halt(311);
    Seek(FichPaleta,NumeroPaleta);
    BlockRead(FichPaleta,PalPaso,768);
    Close(FichPaleta);
   End
  Else
   Begin
    Assign(FichPaleta,NombrePaleta+'.PAL');
    {$I-} Reset(FichPaleta,1); {$I+}
    If IOResult<>0 Then Halt(311);
    BlockRead(FichPaleta,PalPaso,768);
    Close(FichPaleta);
   End;
 For IPal:=0 To 255 Do
  Begin
   PalNegro[IPal,1]:=0;
   PalNegro[IPal,2]:=0;
   PalNegro[IPal,3]:=0;
  End;
 CambiaPaleta(PalNegro,PalPaso);
 Pal:=PalPaso;
End;

Procedure Fundido_de_Negro_Parcial(NumCol:Byte);
Var PalNegro:Paleta;
Begin
 For IPal:=0 To NumCol Do
  Begin
   PalNegro[IPal,1]:=0;
   PalNegro[IPal,2]:=0;
   PalNegro[IPal,3]:=0;
  End;
 For IPal:=(NumCol+1) To 255 Do
  Begin
   PalNegro[IPal,1]:=Pal[IPal,1];
   PalNegro[IPal,2]:=Pal[IPal,2];
   PalNegro[IPal,3]:=Pal[IPal,3];
  End;
 CambiaPaleta(PalNegro,Pal);
End;

Procedure ActualizaPaleta(IndicePaleta:Byte);
Begin
 Case Parte_del_Juego of
  1:Begin {animacion de paleta de las pantallas de la primera parte}
     For IPal:=0 To 5 Do
      Begin
       Pal[(IPal+195),1]:=MovimientoPal[((IndicePaleta*6)+IPal),1];
       Pal[(IPal+195),2]:=MovimientoPal[((IndicePaleta*6)+IPal),2];
       Pal[(IPal+195),3]:=MovimientoPal[((IndicePaleta*6)+IPal),3];
      End;
     CambiaBloqueRGB(195,6,Pal[195,1]);
    End;
  2:Begin {reflejos del suelo de la segunda parte}
    End;
 End;
End;

Procedure Procesando_Activo;
Var
 OldTexto:TextSettingsType;
Begin
 GetTextSettings(OldTexto);
 SetTextStyle(Peque,HorizDir,4);
 SetTextJustify(0,2);
 SetRGBPalette(255,63,63,63);
 SetColor(0);
 OutTextXY(121,72,'PROCESANDO......');
 OutTextXY(120,71,'PROCESANDO......');
 OutTextXY(119,72,'PROCESANDO......');
 OutTextXY(120,73,'PROCESANDO......');
 SetColor(255);
 OutTextXY(120,72,'PROCESANDO......');
 SetTextStyle(OldTexto.Font,OldTexto.Direction,OldTexto.CharSize);
End;

BEGIN
 For IPal:=0 to 63 Do
  For JPal:=1 to 64 Do
   DatosFundido[IPal,JPal]:=IPal Div JPal;
 Inicializa;
 ExitGraph:=ExitProc;
 ExitProc:=@GraphSalida;
END.